home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TIPS / STATUS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-09  |  4KB  |  150 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Tips & Techniques Demo Program               }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program MDIStatusLine;
  10.  
  11. {$R MDIAPP.RES}
  12.  
  13. uses WObjects, WinTypes, WinProcs, Strings, WinDos;
  14.  
  15. const
  16.   StatusLineHeight = 20;
  17.  
  18. type
  19.   PStatusLine = ^TStatusLine;
  20.   TStatusLine = object(TWindow)
  21.     constructor Init(AParent: PWindowsObject);
  22.     function  GetClassName: PChar;  virtual;
  23.     procedure GetWindowClass(var AWndClass : TWndClass); virtual;
  24.     procedure WriteTime;
  25.   end;
  26.  
  27.   PMyMDIWindow = ^TMyMDIWindow;
  28.   TMyMDIWindow = object(TMDIWindow)
  29.     StatusLine : PStatusLine;
  30.     constructor Init(ATitle: PChar;  AMenu: HMenu);
  31.     destructor Done; virtual;
  32.     procedure SetUpWindow; virtual;
  33.     procedure WMSize(var Message: TMessage);
  34.       virtual wm_Size;
  35.     procedure WMTimer(var Message: TMessage);
  36.       virtual wm_Timer;
  37.    end;
  38.  
  39.   TMDIApp = object(TApplication)
  40.     procedure InitMainWindow; virtual;
  41.   end;
  42.  
  43. constructor TStatusLine.Init(AParent: PWindowsObject);
  44. begin
  45.   TWindow.Init(AParent, '');      { create the window normally }
  46.   SetFlags(wb_MDIChild, False);   {turn off the MDI flag that TWindow set }
  47.   Attr.Style := ws_Border or ws_Child or ws_Visible;
  48. end;
  49.  
  50. function TStatusLine.GetClassName: PChar;
  51. begin
  52.   GetClassName := 'TurboStatusLine';
  53. end;
  54.  
  55. procedure TStatusLine.GetWindowClass(var AWndClass : TWndClass);
  56. begin
  57.   TWindow.GetWindowClass(AWndClass);
  58.   AWndClass.hbrBackGround := GetStockObject(White_Brush);
  59. end;
  60.  
  61. procedure TStatusLine.WriteTime;
  62. var
  63.   DC: HDC;
  64.   S, Temp: array[0..100] of Char;
  65.   Hour, Minute, Second, hs: Word;
  66.   Width: Integer;
  67. begin
  68.   DC := GetDC(HWindow);
  69.   GetTime(Hour, Minute, Second, hs);
  70.   Str(Hour: 2, S);
  71.   StrCat(S, ':');
  72.   Str(Minute:2, Temp);
  73.   if Temp[0] = ' ' then Temp[0] := '0';
  74.   StrCat(S, Temp);
  75.   StrCat(S, ':');
  76.   Str(Second:2, Temp);
  77.   if Temp[0] = ' ' then Temp[0] := '0';
  78.   StrCat(S, Temp);
  79.   TextOut(DC, 5, 2, S, StrLen(S));
  80.   Width := LoWord(GetTextExtent(DC, S, StrLen(S)));
  81.   MoveTo(DC, Width + 10, 0);
  82.   LineTo(DC, Width + 10, StatusLineHeight);
  83.   ReleaseDC(HWindow, DC);
  84. end;
  85.  
  86. constructor TMyMDIWindow.Init(ATitle: PChar;  AMenu: HMenu);
  87. begin
  88.   TMDIWindow.Init(ATitle, AMenu);
  89.   StatusLine := New(PStatusLine, Init(@Self));
  90. end;
  91.  
  92. destructor TMyMDIWindow.Done;
  93. begin
  94.   KillTimer(HWindow, 1);
  95.   TWindow.Done;
  96. end;
  97.  
  98. procedure TMyMDIWindow.SetUpWindow;
  99. begin
  100.   TMDIWindow.SetUpWindow;
  101.   SetTimer(HWindow, 1, 1000, Nil);
  102. end;
  103.  
  104. procedure TMyMDIWindow. WMSize(var Message: TMessage);
  105. begin
  106.   TMDIWindow.WMSize(Message);
  107.  
  108.   { Always check for nil window pointers and invalid HWindow handles.
  109.     Windows can send your main window WMSize messages while the child
  110.     windows are being destroyed, which can produce some hard to track
  111.     down UAEs.  }
  112.  
  113.   if (ClientWnd <> nil) and (ClientWnd^.HWindow <> 0) then
  114.     if Message.LParamHi > 20 then
  115.     MoveWindow(ClientWnd^.HWindow, 0, 0, Message.LParamLo, Message.LParamHi -
  116.       StatusLineHeight, True);
  117.   if (StatusLine <> nil) and (StatusLine^.HWindow <> 0) then
  118.    if Message.LParamHi > 20 then
  119.     MoveWindow(StatusLine^.HWindow, - 1, Message.LParamHi - StatusLineHeight,
  120.     Message.LParamLo + 2, Message.LParamHi, True);
  121.  
  122. { The -1 and +2 are to hide the left and right borders of this
  123. Status window. It looks funny with no border at all, but it looks funny
  124. with extra thick borders on the left and right.  This sets a happy medium.  }
  125.  
  126. end;
  127.  
  128. procedure TMyMDIWindow.WMTimer(var Message: TMessage);
  129. begin
  130.   StatusLine^.WriteTime;
  131. end;
  132.  
  133. { Construct the THelloApp's MainWindow object, loading its menu }
  134. procedure TMDIApp.InitMainWindow;
  135. begin
  136.   MainWindow := New(PMyMDIWindow, Init('MDI StatusLine',
  137.     LoadMenu(HInstance, 'MDIMenu')));
  138. end;
  139.  
  140. { Declare a variable of type TMDIApp}
  141. var
  142.   MDIApp: TMDIApp;
  143.  
  144. { Run the MDIApp }
  145. begin
  146.   MDIApp.Init('MDIApp');
  147.   MDIApp.Run;
  148.   MDIApp.Done;
  149. end.
  150.